home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / TURB_VIS / TVISION / CALC.PAS next >
Pascal/Delphi Source File  |  1990-10-23  |  6KB  |  268 lines

  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal 6.0                             }
  4. {   Turbo Vision Demo                            }
  5. {   Copyright (c) 1990 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. unit Calc;
  10.  
  11. {$F+,O+,S-,D-}
  12.  
  13. { Calculator object. See TVDEMO.PAS for an example
  14.   program that uses this unit.
  15. }
  16.  
  17. interface
  18.  
  19. uses Drivers, Objects, Views, Dialogs;
  20.  
  21. type
  22.  
  23.   TCalcState = (csFirst, csValid, csError);
  24.  
  25.   PCalcDisplay = ^TCalcDisplay;
  26.   TCalcDisplay = object(TView)
  27.     Status: TCalcState;
  28.     Number: string[15];
  29.     Sign: Char;
  30.     Operator: Char;
  31.     Operand: Real;
  32.     constructor Init(var Bounds: TRect);
  33.     constructor Load(var S: TStream);
  34.     procedure CalcKey(Key: Char);
  35.     procedure Clear;
  36.     procedure Draw; virtual;
  37.     function GetPalette: PPalette; virtual;
  38.     procedure HandleEvent(var Event: TEvent); virtual;
  39.     procedure Store(var S: TStream);
  40.   end;
  41.  
  42.   PCalculator = ^TCalculator;
  43.   TCalculator = object(TDialog)
  44.     constructor Init;
  45.   end;
  46.  
  47. const
  48.   RCalcDisplay: TStreamRec = (
  49.      ObjType: 10040;
  50.      VmtLink: Ofs(TypeOf(TCalcDisplay)^);
  51.      Load:    @TCalcDisplay.Load;
  52.      Store:   @TCalcDisplay.Store
  53.   );
  54.   RCalculator: TStreamRec = (
  55.      ObjType: 10041;
  56.      VmtLink: Ofs(TypeOf(TCalculator)^);
  57.      Load:    @TCalculator.Load;
  58.      Store:   @TCalculator.Store
  59.   );
  60.  
  61. procedure RegisterCalc;
  62.  
  63. implementation
  64.  
  65. const
  66.   cmCalcButton = 100;
  67.  
  68. constructor TCalcDisplay.Init(var Bounds: TRect);
  69. begin
  70.   TView.Init(Bounds);
  71.   Options := Options or ofSelectable;
  72.   EventMask := evKeyDown + evBroadcast;
  73.   Clear;
  74. end;
  75.  
  76. constructor TCalcDisplay.Load(var S: TStream);
  77. begin
  78.   TView.Load(S);
  79.   S.Read(Status, SizeOf(Status) + SizeOf(Number) + SizeOf(Sign) +
  80.     SizeOf(Operator) + SizeOf(Operand));
  81. end;
  82.  
  83. procedure TCalcDisplay.CalcKey(Key: Char);
  84. var
  85.   R: Real;
  86.  
  87. procedure Error;
  88. begin
  89.   Status := csError;
  90.   Number := 'Error';
  91.   Sign := ' ';
  92. end;
  93.  
  94. procedure SetDisplay(R: Real);
  95. var
  96.   S: string[63];
  97. begin
  98.   Str(R: 0: 10, S);
  99.   if S[1] <> '-' then Sign := ' ' else
  100.   begin
  101.     Delete(S, 1, 1);
  102.     Sign := '-';
  103.   end;
  104.   if Length(S) > 15 + 1 + 10 then Error
  105.   else
  106.   begin
  107.     while S[Length(S)] = '0' do Dec(S[0]);
  108.     if S[Length(S)] = '.' then Dec(S[0]);
  109.     Number := S;
  110.   end;
  111. end;
  112.  
  113. procedure GetDisplay(var R: Real);
  114. var
  115.   E: Integer;
  116. begin
  117.   Val(Sign + Number, R, E);
  118. end;
  119.  
  120. procedure CheckFirst;
  121. begin
  122.   if Status = csFirst then
  123.   begin
  124.     Status := csValid;
  125.     Number := '0';
  126.     Sign := ' ';
  127.   end;
  128. end;
  129.  
  130. begin
  131.   Key := UpCase(Key);
  132.   if (Status = csError) and (Key <> 'C') then Key := ' ';
  133.   case Key of
  134.     '0'..'9':
  135.       begin
  136.         CheckFirst;
  137.         if Number = '0' then Number := '';
  138.         Number := Number + Key;
  139.       end;
  140.     '.':
  141.       begin
  142.         CheckFirst;
  143.         if Pos('.', Number) = 0 then Number := Number + '.';
  144.       end;
  145.     #8, #27:
  146.       begin
  147.         CheckFirst;
  148.         if Length(Number) = 1 then Number := '0' else Dec(Number[0]);
  149.       end;
  150.     '_', #241:
  151.       if Sign = ' ' then Sign := '-' else Sign := ' ';
  152.     '+', '-', '*', '/', '=', '%', #13:
  153.       begin
  154.         if Status = csValid then
  155.         begin
  156.           Status := csFirst;
  157.           GetDisplay(R);
  158.           if Key = '%' then
  159.             case Operator of
  160.               '+', '-': R := Operand * R / 100;
  161.               '*', '/': R := R / 100;
  162.             end;
  163.           case Operator of
  164.             '+': SetDisplay(Operand + R);
  165.             '-': SetDisplay(Operand - R);
  166.             '*': SetDisplay(Operand * R);
  167.             '/': if R = 0 then Error else SetDisplay(Operand / R);
  168.           end;
  169.         end;
  170.         Operator := Key;
  171.         GetDisplay(Operand);
  172.       end;
  173.     'C':
  174.       Clear;
  175.   end;
  176.   DrawView;
  177. end;
  178.  
  179. procedure TCalcDisplay.Clear;
  180. begin
  181.   Status := csFirst;
  182.   Number := '0';
  183.   Sign := ' ';
  184.   Operator := '=';
  185. end;
  186.  
  187. procedure TCalcDisplay.Draw;
  188. var
  189.   Color: Byte;
  190.   I: Integer;
  191.   B: TDrawBuffer;
  192. begin
  193.   Color := GetColor(1);
  194.   I := Size.X - Length(Number) - 2;
  195.   MoveChar(B, ' ', Color, Size.X);
  196.   MoveChar(B[I], Sign, Color, 1);
  197.   MoveStr(B[I + 1], Number, Color);
  198.   WriteBuf(0, 0, Size.X, 1, B);
  199. end;
  200.  
  201. function TCalcDisplay.GetPalette: PPalette;
  202. const
  203.   P: string[1] = #19;
  204. begin
  205.   GetPalette := @P;
  206. end;
  207.  
  208. procedure TCalcDisplay.HandleEvent(var Event: TEvent);
  209. begin
  210.   TView.HandleEvent(Event);
  211.   case Event.What of
  212.     evKeyDown:
  213.       begin
  214.         CalcKey(Event.CharCode);
  215.         ClearEvent(Event);
  216.       end;
  217.     evBroadcast:
  218.       if Event.Command = cmCalcButton then
  219.       begin
  220.         CalcKey(PButton(Event.InfoPtr)^.Title^[1]);
  221.         ClearEvent(Event);
  222.       end;
  223.   end;
  224. end;
  225.  
  226. procedure TCalcDisplay.Store(var S: TStream);
  227. begin
  228.   TView.Store(S);
  229.   S.Write(Status, SizeOf(Status) + SizeOf(Number) + SizeOf(Sign) +
  230.     SizeOf(Operator) + SizeOf(Operand));
  231. end;
  232.  
  233. { TCalculator }
  234.  
  235. constructor TCalculator.Init;
  236. const
  237.   KeyChar: array[0..19] of Char = 'C'#27'%'#241'789/456*123-0.=+';
  238. var
  239.   I: Integer;
  240.   P: PView;
  241.   R: TRect;
  242. begin
  243.   R.Assign(5, 3, 29, 18);
  244.   TDialog.Init(R, 'Calculator');
  245.   Options := Options or ofFirstClick;
  246.   for I := 0 to 19 do
  247.   begin
  248.     R.A.X := (I mod 4) * 5 + 2;
  249.     R.A.Y := (I div 4) * 2 + 4;
  250.     R.B.X := R.A.X + 5;
  251.     R.B.Y := R.A.Y + 2;
  252.     P := New(PButton, Init(R, KeyChar[I], cmCalcButton,
  253.       bfNormal + bfBroadcast));
  254.     P^.Options := P^.Options and not ofSelectable;
  255.     Insert(P);
  256.   end;
  257.   R.Assign(3, 2, 21, 3);
  258.   Insert(New(PCalcDisplay, Init(R)));
  259. end;
  260.  
  261. procedure RegisterCalc;
  262. begin
  263.   RegisterType(RCalcDisplay);
  264.   RegisterType(RCalculator);
  265. end;
  266.  
  267. end.
  268.